perm filename MAKVID.SAI[GEO,BGB] blob
sn#001317 filedate 1972-09-01 generic text, type T, neo UTF8
00100 ENTRY DUMMY;
00200 BEGIN "MAKVID - MAKE VIDEO IMAGE - AUGUST 1972"
00300 REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
00400 REQUIRE "WINGED.SAI" SOURCE_FILE;
00500
00600 PRELOAD_WITH 7,0,6,288,48,20,235,28,315,10368;
00700 ITG ARRAY HEADER[0:9];
00800
00900 EXTERNAL PROCEDURE FACOEF (ITG B,FLG);
01000
01100 SAFE ITG ARRAY PIXEL[0:287];
01200
01300 REQUIRE "DPYIII[SYS,BGB]" SOURCE_FILE;
01400 SAFE ITG ARRAY DPYBUF[1:500];
00100 INTERNAL PROCEDURE MAKVID;
00200 BEGIN "MAKVID"
00300 SAFE ITG ARRAY TVBUF[0:10367];
00400 ITG ROW,COL,CHN,FLG;
00500
00600 α STORE PIXEL BRIGHTNESS INTO RASTER;
00700 SUBR DOT→(ITG BRT;SHORT REAL X,Y);
00800 BEGIN
00900 ITG ROW,COL,PTR,BYT;
01000 ROW ← 108 - Y; ROW ← (0 MAX ROW)MIN 215;
01100 COL ← X + 144; COL ← (0 MAX COL)MIN 287;
01200 PTR ← POINT(6,TVBUF[ROW*48+(COL DIV 6)],6*(COL MOD 6)+5);
01400 BYT ← LDB(PTR);
01500 DPB(BRT MAX BYT,PTR);
01600 END;
00100 SUBR RASTERIZE (ITG E);
00200 BEGIN "RASTERIZE"
00300
00400 SHORT REAL X1,Y1,X2,Y2; ITG V1,V2,LX,LY;
00500 ITG I1,I2,NF,PF;
00600 REAL A,B,C,Q,FC,X,Y;
00700 ITG I,L,BRT,NBRT,PBRT;
00800 EXTERNAL REAL PROCEDURE SQRT (REAL X);
00900 ITG JAG,UFACE;
01000 EXTERNAL ITG BGND;
01100
01200 α PICK HER UP & GET V1 ON TOP;
01300 JAG ← CAR(E)LAND '020100;
01400 IF JAG≠0 THEN JAG←+1;
01500 V1 ← NVT(E);
01600 V2 ← PVT(E);
01700 IF YPP(V1)<YPP(V2) THEN ⊂ V1↔V2;JAG←-JAG;⊃;
01800
01900
02000 A ← YPP(V1) - YPP(V2);
02100 B ← XPP(V2) - XPP(V1);
02200 C ← XPP(V1)*YPP(V2) - XPP(V2)*YPP(V1);
02300 Q ← SQRT(A↑2+B↑2); A←A/Q;B←B/Q;C←C/Q;
02400
02500 X ← X1 ← XPP(V1); X2 ← XPP(V2);
02600 Y ← Y1 ← YPP(V1); Y2 ← YPP(V2);
02700
02800 I1←X1;I2←X2;LX←ABS(X1-X2);
02900 I1←Y1;I2←Y2;LY←ABS(Y1-Y2);
03000 L ← LX+LY;
03100
03200 NF ← (IF CAR(E)LAND '100 THEN CDR(E+7) ELSE NFACE(E));
03250 PF ← PFACE(E);
03300 FC ← (IF(NF=BGND)THEN ABS(CC(PF)) ELSE
03400 (ABS(CC(PF))+ABS(CC(NF)))/2);
03500 IF JAG≠0 THEN IF NF=BGND THEN NBRT←1 ELSE
03600 ⊂ NBRT←((4 MAX CC(NFACE(E))*64)MIN '77);
03700 NBRT←NBRT LAND '76;⊃;
03800 BRT ← ((4 MAX FC*64)MIN '77);
03900 BRT ← BRT LAND '76;
00100 IF JAG THEN DOT→(NBRT,X+JAG,Y);
00200 α DOWN AND RIGHT;
00300 IF X2≥X1 THEN
00400 FOR I←1 TO L DO
00500 BEGIN
00600 DECREM(Y);
00700 INCREM(X);
00800 Q ← A*X + B*Y + C;
00900 IF Q≤0 THEN INCREM(Y) ELSE ⊂ DECREM(X);
01000 IF JAG=+1 THEN DOT→(NBRT,X+1,Y+1) ELSE
01100 IF JAG=-1 THEN DOT→(NBRT,X-1,Y);⊃;
01200 DOT→(BRT,X,Y);
01300 END;
01400
01500 α DOWN AND LEFT;
01600 IF X2<X1 THEN
01700 FOR I←1 TO L DO
01800 BEGIN
01900 DECREM(Y);
02000 DECREM(X);
02100 Q ← A*X + B*Y + C;
02200 IF Q≤0 THEN ⊂ INCREM(X);
02300 IF JAG=+1 THEN DOT→(NBRT,X+1,Y) ELSE
02400 IF JAG=-1 THEN DOT→(NBRT,X-1,Y+1);
02500 ⊃ ELSE INCREM(Y);
02600 DOT→(BRT,X,Y);
02700 END;
02800 IF JAG THEN DOT→(NBRT,X+JAG,Y);
00100 IF ABS(X-X2)≥1 ∨ ABS(Y-Y2)≥1 THEN
00200 BEGIN
00300 OUTSTR("END-POINT MISMATCH: "&9&CVG(X-X2)&9&CVG(Y-Y2)&↓);
00400 OUTSTR(9&"L = "&CVS(L)&" = "&
00500 CVG(ABS(XPP(V1)-XPP(V2))+ABS(YPP(V1)-YPP(V2)) )&↓);
00600 OUTSTR(9&"X1 = "&CVG(X1));
00700 OUTSTR(9&"Y1 = "&CVG(Y1));
00800 OUTSTR(↓);
00900 OUTSTR(9&"X2 = "&CVG(X2));
01000 OUTSTR(9&"Y2 = "&CVG(Y2));
01100 OUTSTR(↓);
01200 OUTSTR(9&"X = "&CVG(X ));
01300 OUTSTR(9&"Y = "&CVG(Y ));
01400 OUTSTR(↓);
01500 INCHRW;
01600 END;
01700
01800
01900 END "RASTERIZE";
00100 LABEL L1,L2;
00200 ITG B,E;
00300
00400 B ← WORLD;
00500 L1: B ← PBODY(B);
00600 IF BTYPE(B) THEN ⊂
00700 α FACOEF(B,FALSE);
00800 E←B;
00900 L2: E ← PED(E);
01000 IF ETYPE(E) THEN ⊂
01100 α VISIBLE OR POTENT;
01200 IF ('60 LAND(CAR(E))≠0) THEN RASTERIZE(E);
01300 GO L2;⊃;
01400 GO L1;⊃;
00100 α FILL IN TV RASTER BY LINEAR INTERPOLATION;
00200 FOR ROW←0 TO 215 DO
00300 BEGIN "FILL"
00400 LABEL L1,L2;
00500 ITG XX,YY,YDEL,VAL;
00600 INTEGER PTR,PTR0,I,I1,I2,Z,DX,DZ;
00700 DPYSET(DPYBUF); AIVECT(-511,YY←(3.5*(108-ROW)));
00800 DPYSST(CVS(ROW));
00900 AVECT(511,(3.5*(108-ROW)));DPYBIG(1);
01000
01100 α PICK 'EM UP;
01200 PTR0 ← PTR ← POINT(6,TVBUF[ROW*48],-1);
01300 VAL←YDEL←0;
01400 FOR I←0 TO 287 DO
01500 BEGIN
01600 PIXEL[I]←(ILDB(PTR) LSH 18);
01700 YDEL←0 MAX(YDEL-3);
01800 IF PIXEL[I]≠0 ∧ (PIXEL[I]='1000000 ∨ PIXEL[I]≠VAL) THEN
01900 BEGIN
02000 VAL ← PIXEL[I] LSH -18;
02100 AIVECT(XX←3.5*(I-144),YY);
02200 IF VAL≠1 THEN ⊂ YDEL ← YDEL+20;
02300 AVECT(XX,YY+YDEL);⊃ ELSE AVECT(XX,YY-20);
02400 DPYSST(CVS(VAL));
02500 END;
02600 END;
02700 DPYOUT(7);
02800
02900 I2←0;
03000 α LOOK FOR BLANK PIXELS;
03100 L1: I1←I2; DO INCREM(I2) UNTIL PIXEL[I2]∨I2=287;
03200 Z ← PIXEL[I1];
03300 DX ← (I2-I1);
03400 DZ ← (PIXEL[I2]-Z)/DX;
03500
03600 α FILL THE BLANKS BY LINEAR INTERPOLATION;
03700 IF DZ=0 THEN
03800 ARRBLT(PIXEL[I1+1],PIXEL[I1],(DX-1)) ELSE
03900 FOR I←(I1+1) TO (I2-1) DO
04000 PIXEL[I]←(Z←Z+DZ)LAND '76000000;
04100
04200 α PUT 'EM BACK;
04300 L2: PTR ← PTR0;
04400 FOR I←0 TO 287 DO IDPB((PIXEL[I]LSH -18),PTR);
04500 IF I2<287 THEN GO L1;
04600 END "FILL";
00100 α OUTPUT VIDEO IMAGE DSK FILE;
00200 CHN ← GETCHAN;
00300 OPEN(CHN,"DSK",8,0,3,0,0,0);
00400 ENTER(CHN,"TMP.TMP[DAT,BGB]",FLG);
00500 ARRYOUT(CHN,HEADER[0],10);
00600 ARRYOUT(CHN,TVBUF[0],10367);
00700 RELEASE(CHN);
00800 OUTSTR(9&"MAKVID EOF"&↓);
00900 END "MAKVID";
01000 END;